home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Info / For Developers / GhostScript 5.10 / MacGS-510 / files / printafm.ps < prev    next >
Text File  |  1995-09-06  |  3KB  |  147 lines
  1. %!
  2. % written by James Clark <jjc@jclark.uucp>
  3. % print an afm file on the standard output
  4. % usage is `fontname printafm' eg `/Times-Roman printafm'
  5.  
  6. % From the `dvitops' distribution, which included this notice:
  7. % dvitops is not copyrighted; you can do with it exactly as you please.
  8. % I would, however, ask that if you make improvements or modifications,
  9. % you ask me before distributing them to others.
  10.  
  11. % Altered by d.love@dl.ac.uk to produce input for Rokicki's afm2tfm,
  12. % which groks the format of the Adobe AFMs.
  13.  
  14. % Modified by L. Peter Deutsch 9/14/93:
  15. %   uses Ghostscript's =only procedure to replace 'buf cvs print'.
  16. % Modified by L. Peter Deutsch 9/6/95:
  17. %   uses Ghostscript's shellarguments facility to accept the font name
  18. %     on the command line.
  19.  
  20. /onechar 1 string def
  21.  
  22. % c toupper - c
  23. /toupper {
  24.     dup dup 8#141 ge exch 8#172 le and { 
  25.         8#40 sub
  26.     } if
  27. } bind def
  28.  
  29. % printcharmetrics -
  30.  
  31. /printcharmetrics {
  32.     (StartCharMetrics ) print
  33.     currentfont /CharStrings get dup length exch /.notdef known { 1 sub } if =
  34.     currentfont 1000 scalefont setfont 0 0 moveto
  35.     /e currentfont /Encoding get def
  36.     0 1 255 {
  37.         dup e exch get
  38.         dup /.notdef ne {
  39.             exch dup printmetric
  40.         } {
  41.             pop pop
  42.         } ifelse
  43.     } for
  44.     % s contains an entry for each name in the original encoding vector
  45.     /s 256 dict def
  46.     e {
  47.         s exch true put
  48.     } forall
  49.     % v is the new encoding vector
  50.     /v 256 array def
  51.     0 1 255 {
  52.         v exch /.notdef put
  53.     } for
  54.     % fill up v with names in CharStrings
  55.     /i 0 def
  56.     currentfont /CharStrings get {
  57.         pop
  58.         i 255 le {
  59.             v i 3 -1 roll put
  60.             /i i 1 add def
  61.         } {
  62.             pop
  63.         } ifelse
  64.     } forall
  65.     % define a new font with v as its encoding vector
  66.     currentfont maxlength dict /f exch def
  67.     currentfont {
  68.         exch dup dup /FID ne exch /Encoding ne and { 
  69.             exch f 3 1 roll put
  70.         } { 
  71.             pop pop 
  72.         } ifelse
  73.     } forall
  74.     f /Encoding v put
  75.     f /FontName /temp put
  76.     % make this new font the current font
  77.     /temp f definefont setfont
  78.     % print a entry for each character not in old vector
  79.     /e currentfont /Encoding get def
  80.     0 1 255 {
  81.         dup e exch get
  82.         dup dup /.notdef ne exch s exch known not and { 
  83.             exch -1 printmetric
  84.         } { 
  85.             pop pop
  86.         } ifelse
  87.     } for
  88.     (EndCharMetrics) =
  89. } bind def
  90.  
  91. % name actual_code normal_code printmetric -
  92.  
  93. /printmetric {
  94.     /saved save def
  95.     (C ) print =only
  96.     ( ; WX ) print
  97.     onechar 0 3 -1 roll put
  98.     onechar stringwidth pop round cvi =only
  99.     ( ; N ) print =only
  100.     ( ; B ) print
  101.     onechar false charpath flattenpath mark pathbbox counttomark {
  102.         counttomark -1 roll
  103.         round cvi =only
  104.         ( ) print
  105.     } repeat pop
  106.     (;) =
  107.     saved restore
  108. } bind def
  109.  
  110. % fontname printafm -
  111.  
  112. /printafm {
  113.     findfont gsave setfont
  114.     (StartFontMetrics 2.0) =
  115.     (FontName ) print currentfont /FontName get =
  116.  
  117.         % Print the FontInfo
  118.  
  119.     currentfont /FontInfo get {
  120.         exch
  121.         =string cvs dup dup 0 get 0 exch toupper put print
  122.         ( ) print =
  123.     } forall
  124.  
  125.         % Print the FontBBox
  126.  
  127.     (FontBBox) print
  128.     currentfont /FontBBox get {
  129.         ( ) print round cvi =only
  130.     } forall
  131.     (\n) print
  132.  
  133.     printcharmetrics
  134.     (EndFontMetrics) =
  135.     grestore
  136. } bind def
  137.  
  138. % Check for command line arguments.
  139. [ shellarguments
  140.  { ] dup length 1 eq
  141.     { 0 get printafm }
  142.     { (Usage: printafm fontname\n) print flush }
  143.    ifelse
  144.  }
  145.  { pop }
  146. ifelse
  147.